Mastering Internet Develo…oft ActiveX Technologies/Mastering Internet Development with ActiveX (1996)(Microsoft).iso/labs/lab09/solution/frmleads.frm

Visual Basic Form | 1996-07-16 | 7KB | 231 lines

VERSION 4.00
Begin VB.Form frmLeads
   Caption         =   "Sales Leads"
   ClientHeight    =   5940
   ClientLeft      =   1725
   ClientTop       =   1785
   ClientWidth     =   6690
   Height          =   6630
   Left            =   1665
   LinkTopic       =   "Form1"
   ScaleHeight     =   5940
   ScaleWidth      =   6690
   Top             =   1155
   Width           =   6810
   Begin SHDocVwCtl.WebBrowser dwnLoad
      Height          =   735
      Left            =   240
      TabIndex        =   1
      Top             =   3360
      Visible         =   0   'False
      Width           =   1215
      Object.Height          =   49
      Object.Width           =   81
      AutoSize        =   0
      ViewMode        =   1
      AutoSizePercentage=   0
      AutoArrange     =   -1  'True
      NoClientEdge    =   -1  'True
      AlignLeft       =   0   'False
      Location        =   "C:\WINDOWS\SYSTEM\BLANK.HTM"
   End
   Begin ComctlLib.ListView lstLeads
      Height          =   2295
      Left            =   480
      TabIndex        =   0
      Top             =   360
      Width           =   4695
      _Version        =   65536
      _ExtentX        =   8281
      _ExtentY        =   4048
      _StockProps     =   205
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   1
      HideSelection   =   0   'False
      Icons           =   ""
      LabelWrap       =   0   'False
      SmallIcons      =   ""
      View            =   3
      NumItems        =   6
      i1              =   "frmLeads.frx":0000
      i2              =   "frmLeads.frx":00B8
      i3              =   "frmLeads.frx":0174
      i4              =   "frmLeads.frx":0224
      i5              =   "frmLeads.frx":02DC
      i6              =   "frmLeads.frx":0394
   End
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuFileRead
         Caption         =   "&Read Leads List"
      End
      Begin VB.Menu mnuLine1
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileSend
         Caption         =   "&Send E-mail"
      End
      Begin VB.Menu mnuFileWebIE
         Caption         =   "Open Web Site in &Internet Explorer"
      End
      Begin VB.Menu mnuFileWebVB
         Caption         =   "Open Web Site in &VB"
      End
      Begin VB.Menu mnuLine2
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuPopup
      Caption         =   "lstPopup"
      Visible         =   0   'False
      Begin VB.Menu mnuPopEmail
         Caption         =   "&Send E-mail"
      End
      Begin VB.Menu mnuPopWebIE
         Caption         =   "Open &Web Site in Internet Explorer"
      End
      Begin VB.Menu mnuPopWebVB
         Caption         =   "Open Web Site in &VB"
      End
   End
Attribute VB_Name = "frmLeads"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim MailSession As Object
Private Sub OpenWebInIE()
    Dim strWeb As String
    Dim browser As InternetExplorer
    'read the web site address (subitem 5) from the selected list entry
    strWeb = lstLeads.SelectedItem.SubItems(5)
    'start up IE
    Set browser = CreateObject("InternetExplorer.Application")
    browser.Visible = True
    browser.Navigate strWeb
End Sub
Private Sub OpenWebInVB()
    frmBrowse.txtAddress.Text = lstLeads.SelectedItem.SubItems(5)
    frmBrowse.Show
    frmBrowse.cmdGo_Click
End Sub
Private Sub SendEmail()
On Error GoTo badlogon
    Dim mailMsg As Object
    Dim mailRecip As Object
    'logon if not already logged on
    If MailSession Is Nothing Then
        Set MailSession = CreateObject("Mapi.session")
        If Not MailSession Is Nothing Then
            MailSession.Logon
        End If
    End If
    Set mailMsg = MailSession.Inbox.Messages.Add
    mailMsg.subject = "Main St. Market Information"
    Set mailRecip = mailMsg.Recipients.Add
    mailRecip.Name = lstLeads.SelectedItem.SubItems(4)
    mailRecip.Type = mapiTo
    mailMsg.Update
    mailMsg.Send ShowDialog:=True
    Exit Sub
badlogon:
    'trying to use mail when something went wrong
    Exit Sub
End Sub
Private Sub FillList()
'read info from a file and fill in lstLeads
    Dim fhandle As Integer
    Dim filename As String
    Dim strSalesman As String
    Dim strCustomer As String
    Dim strCompany As String
    Dim strPhone As String
    Dim strEmail As String
    Dim strWeb As String
    Dim itmX As ListItem
    fhandle = FreeFile
    filename = App.Path & "\leads.mlt"
    Open filename For Input As fhandle
    Do While Not EOF(1) ' Loop until end of file.
        'read line of information
        Input #fhandle, strSalesman, strCustomer, strCompany, strPhone, strEmail, strWeb
        'add to listview control
        Set itmX = lstLeads.ListItems.Add()
        itmX.Text = strSalesman
        itmX.SubItems(1) = strCustomer
        itmX.SubItems(2) = strCompany
        itmX.SubItems(3) = strPhone
        itmX.SubItems(4) = strEmail
        itmX.SubItems(5) = strWeb
    Loop
    Close fhandle
    'enable menu items
    EnableMenuItems True
End Sub
Sub ClearList()
    Dim i
    For i = 1 To lstLeads.ListItems.Count
        lstLeads.ListItems.Remove 1
    Next
End Sub
Sub EnableMenuItems(enable As Boolean)
    mnuFileSend.Enabled = enable
    mnuFileWebIE.Enabled = enable
    mnuFileWebVB.Enabled = enable
End Sub
Private Sub Form_Load()
    EnableMenuItems False
End Sub
Private Sub Form_Resize()
    Dim c As ColumnHeader
    Dim hdrWidth As Integer
    'make lstLeads the size of frmLeads
    lstLeads.Move 0, 0, frmLeads.ScaleWidth, frmLeads.ScaleHeight
    'split the columns equally
    hdrWidth = (lstLeads.Width / 8)
    For Each c In lstLeads.ColumnHeaders
        c.Width = hdrWidth
    Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'if we've logged onto mail this session, logoff
    If Not MailSession Is Nothing Then
        MailSession.Logoff
    End If
End Sub
Private Sub lstLeads_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'show popup menu on right mouse click
    If Button = vbRightButton And lstLeads.ListItems.Count <> 0 Then
        'make sure user clicked on an item
        frmLeads.PopupMenu mnuPopup, vbPopupMenuRightButton
    End If
End Sub
Private Sub mnuExit_Click()
    Unload frmLeads
End Sub
Private Sub mnuFileRead_Click()
    ClearList
    FillList
End Sub
Private Sub mnuFileSend_Click()
    SendEmail
End Sub
Private Sub mnuFileWebIE_Click()
    OpenWebInIE
End Sub
Private Sub mnuFileWebVB_Click()
    OpenWebInVB
End Sub
Private Sub mnuPopEmail_Click()
    SendEmail
End Sub
Private Sub mnuPopWebIE_Click()
    OpenWebInIE
End Sub
Private Sub mnuPopWebVB_Click()
    OpenWebInVB
End Sub